home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcr / pcr4_4.lha / DIST / gc / GCmalloc.c < prev    next >
C/C++ Source or Header  |  1992-01-29  |  18KB  |  774 lines
  1. /* begincopyright
  2.   Copyright (c) 1988,1990 Xerox Corporation. All rights reserved.
  3.   Use and copying of this software and preparation of derivative works based
  4.   upon this software are permitted. Any distribution of this software or
  5.   derivative works must comply with all applicable United States export
  6.   control laws. This software is made available AS IS, and Xerox Corporation
  7.   makes no warranty about the software, its performance or its conformity to
  8.   any specification. Any person obtaining a copy of this software is requested
  9.   to send their name and post office or electronic mail address to:
  10.     PCR Coordinator
  11.     Xerox PARC
  12.     3333 Coyote Hill Rd.
  13.     Palo Alto, CA 94304
  14.     
  15.   Parts of this software were derived from code bearing the copyright notice:
  16.   
  17.   Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
  18.   This material may be freely distributed, provided this notice is retained.
  19.   This material is provided as is, with no warranty expressed or implied.
  20.   Use at your own risk.
  21.   
  22.   endcopyright */
  23.   
  24. /*
  25.  * September 28, 1990 1:55:36 pm PDT
  26.  */
  27.   
  28. /* Top level allocation routines, and related client-callable routines. */  
  29.  
  30. #define DEBUG       /* Some run-time consistency checks */
  31. #undef DEBUG
  32.  
  33. #define VERBOSE
  34. #undef VERBOSE
  35.  
  36. #include <signal.h>
  37. #include "xr/GCPrivate.h"
  38. #include "xr/ThreadsMsg.h"
  39.  
  40. #define ERROR_RETURN return((XR_Pointer)0)
  41.                  
  42. # ifdef MERGE_SIZES
  43.     /* Set things up so that size_map[i] >= i, but not too much bigger */
  44.     /* and so that size_map contains relatively few distinct entries   */
  45.     /* This is stolen from Russ Atkinson's Cedar quantization          */
  46.     /* alogrithm (but we precompute it).                               */    
  47.     
  48.     void GC_init_size_map()
  49.     {
  50.     register int i;
  51.     int i_rounded_up = 0;
  52.  
  53.     /* Map size 0 to 1.  This avoids problems at lower levels. */
  54.       GC_size_map[0] = 1;
  55.     GC_size_map[1] = 1;
  56.     for (i = 2; i <= 8; i++) {
  57. #           ifdef ALIGN_DOUBLE
  58.           GC_size_map[i] = (i + 1) & (~1);
  59. #           else
  60.           GC_size_map[i] = i;
  61. #           endif
  62.     }
  63.     
  64.     for (i = 9; i <= MAXOBJSZ; i++) {
  65.         if (i_rounded_up < i) {
  66.             register int size = i;
  67.                 register unsigned m = 0;
  68.             
  69.                 while (size > 7) {
  70.                   m += 1;
  71.                   size += 1;
  72.                   size >>= 1;
  73.                 }
  74.             i_rounded_up = size << m;
  75.         if (i_rounded_up > MAXOBJSZ) {
  76.             i_rounded_up = MAXOBJSZ;
  77.         }
  78.         }
  79.         GC_size_map[i] = i_rounded_up;
  80.     }
  81.     }
  82. # endif
  83.  
  84. static GC_alloc_call_back_type alloc_call_back = 0;
  85. static XR_Pointer alloc_call_back_data = 0;
  86.  
  87. void GC_register_alloc_callback(fn, data, Ofn, Odata)
  88. GC_alloc_call_back_type fn;
  89. XR_Pointer data;
  90. GC_alloc_call_back_type *Ofn;
  91. XR_Pointer *Odata;
  92. {
  93.     XR_MonitorEntry(&GC_alloc_callback_ml);
  94.     if (Ofn != 0) {
  95.         *Ofn = alloc_call_back;
  96.     }
  97.     if (Odata != 0) {
  98.         *Odata = alloc_call_back_data;
  99.     }
  100.     alloc_call_back = fn;
  101.     alloc_call_back_data = data;
  102.     XR_MonitorExit(&GC_alloc_callback_ml);
  103.     return;
  104. }
  105.  
  106. /* allocate lb bytes of atomic data */
  107. XR_Pointer GC_malloc_atomic(lb)
  108. int lb;
  109. {
  110. register struct obj *op;
  111. register struct obj **opp;
  112. register long lw = BYTES_TO_WORDS(lb + (sizeof (word)) -1);
  113.  
  114.     /* This should really be installed as a breakpoint. */
  115.       if(alloc_call_back != 0) /* Test is only an optimization */ {
  116.         XR_MonitorEntry(&GC_alloc_callback_ml);
  117.         if(alloc_call_back != 0) {
  118.           op = (struct obj *)((*alloc_call_back)
  119.                    (lb, TRUE, alloc_call_back_data));
  120.           if (op != 0) {
  121.             XR_MonitorExit(&GC_alloc_callback_ml);
  122.             return((XR_Pointer)op);
  123.           }
  124.         }
  125.         XR_MonitorExit(&GC_alloc_callback_ml);
  126.       }
  127.     XR_MonitorEntry(&GC_allocate_ml);
  128.     GC_words_allocd += lw;
  129.     GC_objects_allocd++;
  130.     if( lw <= MAXOBJSZ ) {
  131. #       ifdef MERGE_SIZES
  132.       lw = GC_size_map[lw];
  133. #    else
  134.       if (lw == 0) lw = 1;
  135. #       endif
  136.     opp = &(aobjfreelist[lw]);
  137.     while( (op = *opp) == ((struct obj *)0) ) {
  138.         XR_MonitorExit(&GC_allocate_ml);
  139.         GC_delay_alloc(HBLKSIZE);
  140.         if (!GC_allocaobj(lw)) {
  141.             ERROR_RETURN;
  142.         }
  143.         XR_MonitorEntry(&GC_allocate_ml);
  144.     }
  145. #       ifdef DEBUG
  146.         if ((get_obj_link(op) != ((struct obj *) 0)
  147.         && (((unsigned)get_obj_link(op)) > ((unsigned) HEAPLIM)
  148.            || ((unsigned)get_obj_link(op)) < ((unsigned) HEAPSTART)))) {
  149.         GC_abort("Bad free list in gc_malloc_atomic");
  150.             }
  151. #       endif
  152.     *opp = get_obj_link(op);
  153.     /* op->obj_component[0] = 0; */
  154.     } else {
  155.     register struct hblk * h;
  156.     
  157.     XR_MonitorExit(&GC_allocate_ml);
  158.     GC_delay_alloc(lb);
  159.     XR_MonitorEntry(&GC_allocate_ml);
  160.     if (!GC_sufficient_hb(-lw) && !GC_dont_gc) {
  161.         GC_reclaim_hblks(-lw);
  162.     }
  163. #       ifdef VERBOSE
  164.         GC_vprintf("gc_malloc_atomic calling allochblk(%x)\n",lw);
  165. #    endif
  166.     h = GC_allochblk(-lw);
  167.     if (h == (struct hblk *)0) {
  168.         XR_MonitorExit(&GC_allocate_ml);
  169.         ERROR_RETURN;
  170.     }
  171.     GC_add_hblklist(h);
  172.     op = (struct obj *) (h -> hb_body);
  173.     }
  174. #   ifdef VISUALIZE
  175.     displayAlloc(op, lw);
  176. #   endif
  177.     XR_MonitorExit(&GC_allocate_ml);
  178.     return((XR_Pointer) op);
  179. }
  180.  
  181.  
  182.  
  183. /* allocate lb bytes of possibly composite data */
  184. XR_Pointer GC_malloc(lb)
  185. int lb;
  186. {
  187. register struct obj *op;
  188. register struct obj **opp;
  189. register long lw = BYTES_TO_WORDS(lb + (sizeof (word)) -1);
  190.  
  191.     /* This should really be installed as a breakpoint. */
  192.       if(alloc_call_back != 0) /* Test is only an optimization */ {
  193.         XR_MonitorEntry(&GC_alloc_callback_ml);
  194.         if(alloc_call_back != 0) {
  195.           op = (struct obj *)((*alloc_call_back)
  196.                    (lb, FALSE, alloc_call_back_data));
  197.           if (op != 0) {
  198.             XR_MonitorExit(&GC_alloc_callback_ml);
  199.             return((XR_Pointer)op);
  200.           }
  201.         }
  202.         XR_MonitorExit(&GC_alloc_callback_ml);
  203.       }
  204.  
  205.     XR_MonitorEntry(&GC_allocate_ml);
  206.     GC_words_allocd += lw;
  207.     GC_objects_allocd++;
  208.     if( lw <= MAXOBJSZ ) {
  209. #       ifdef MERGE_SIZES
  210.       lw = GC_size_map[lw];
  211. #    else
  212.       if (lw == 0) lw = 1;
  213. #       endif
  214.     opp = &(objfreelist[lw]);
  215.     while ((op = *opp) == ((struct obj *)0) ) {
  216.         XR_MonitorExit(&GC_allocate_ml);
  217.         GC_delay_alloc(HBLKSIZE);
  218.         if (!GC_allocobj(lw)) {
  219.             ERROR_RETURN;
  220.         }
  221.         XR_MonitorEntry(&GC_allocate_ml);
  222.     }
  223. #       ifdef DEBUG
  224.         if ((get_obj_link(op) != ((struct obj *) 0)
  225.         && (((unsigned)get_obj_link(op)) > ((unsigned) HEAPLIM)
  226.            || ((unsigned)get_obj_link(op)) < ((unsigned) HEAPSTART)))) {
  227.         GC_abort("Bad free list in gc_malloc");
  228.             }
  229. #       endif
  230.     *opp = get_obj_link(op);
  231.     op->obj_component[0] = 0;
  232.     } else {
  233.     register struct hblk * h;
  234.  
  235.     XR_MonitorExit(&GC_allocate_ml);
  236.     GC_delay_alloc(lb);
  237.     XR_MonitorEntry(&GC_allocate_ml);
  238.     if (!GC_sufficient_hb(lw) && !GC_dont_gc) {
  239.         GC_reclaim_hblks(lw);
  240.     }
  241. #       ifdef VERBOSE
  242.         GC_vprintf("gc_malloc calling allochblk(%x)\n",lw);
  243. #    endif
  244.     h = GC_allochblk(lw);
  245.     if (h == (struct hblk *)0) {
  246.         XR_MonitorExit(&GC_allocate_ml);
  247.         ERROR_RETURN;
  248.     }
  249.     GC_add_hblklist(h);
  250.     op = (struct obj *) (h -> hb_body);
  251.     }
  252. #   ifdef VISUALIZE
  253.     displayAlloc(op, lw);
  254. #   endif
  255.     XR_MonitorExit(&GC_allocate_ml);
  256.     return((XR_Pointer)op);
  257. }
  258.  
  259. /* Explicitly deallocate an object p.  We trust the caller to know what he's */
  260. /* doing.                                     */
  261. /* P is assumed to be a pointer to the beginning of the object.             */
  262. void GC_free(p)
  263. struct obj *p;
  264. {
  265.     register struct hblk *h;
  266.     register int sz;
  267.     register word * i;
  268.     register word * limit;
  269.  
  270.     XR_MonitorEntry(&GC_allocate_ml);
  271.     h = HBLKPTR(p);
  272.     sz = hb_sz(h);
  273. #   ifdef VISUALIZE
  274.     displayFree(p, sz);
  275. #   endif
  276.     if (sz < 0) {
  277.         sz = -sz;
  278.         if (sz > MAXOBJSZ) {
  279.         hb_uninit(h) = 1;
  280.         GC_del_hblklist(h);
  281.         GC_freehblk(h);
  282.     } else {
  283.         set_obj_link(p, aobjfreelist[sz]);
  284.         aobjfreelist[sz] = p;
  285.     }
  286.     } else {
  287.     if (sz > MAXOBJSZ) {
  288.         hb_uninit(h) = 1;
  289.         GC_del_hblklist(h);
  290.         GC_freehblk(h);
  291.     } else {
  292.         /* Clear the object, other than link field */
  293.           limit = &(p -> obj_component[sz]);
  294.           for (i = &(p -> obj_component[1]); i < limit; i++) {
  295.         *i = 0;
  296.           }
  297.         set_obj_link(p, objfreelist[sz]);
  298.         objfreelist[sz] = p;
  299.     }
  300.     }
  301.     /* Add it to mem_freed to prevent anomalous heap expansion */
  302.     /* in the event of repeated explicit frees of objects of   */
  303.     /* varying sizes.                                          */
  304.     GC_mem_freed += sz;
  305.     XR_MonitorExit(&GC_allocate_ml);
  306. }
  307.  
  308.  
  309. /* Change the size of the block pointed to by p to contain at least   */
  310. /* lb bytes.  The object may be (and quite likely will be) moved.     */
  311. /* The new object is assumed to be atomic if the original object was. */
  312. /* Shrinking of large blocks is not implemented well.                 */
  313. XR_Pointer GC_realloc(p,lb)
  314. XR_Pointer p;
  315. int lb;
  316. {
  317. register struct obj *op;
  318. register struct obj **opp;
  319. register struct hblk * h;
  320. register int sz;     /* Current size in bytes    */
  321. register int orig_sz;     /* Original sz in bytes    */
  322. bool is_atomic;
  323.  
  324.     h = HBLKPTR(p);
  325.     sz = hb_sz(h);
  326.     if (sz < 0) {
  327.     sz = -sz;
  328.     is_atomic = TRUE;
  329.     } else {
  330.     is_atomic = FALSE;
  331.     }
  332.     sz = WORDS_TO_BYTES(sz);
  333.     orig_sz = sz;
  334.     if (sz > WORDS_TO_BYTES(MAXOBJSZ)) {
  335.     /* Round it up to the next whole heap block */
  336.       sz = (sz+HDR_BYTES+HBLKSIZE-1)
  337.         & (~HBLKMASK);
  338.       sz -= HDR_BYTES;
  339.       hb_sz(h) = BYTES_TO_WORDS(sz);
  340.       /* If this is a composite object, then the remaining part is    */
  341.       /* already cleared.                        */
  342.     }
  343.     
  344.     if (is_atomic) {
  345.       if (lb <= sz) {
  346.     if (lb >= (sz >> 1)) {
  347.         /* Already big enough, but not too much bigger than object. */
  348.         /* Ignore the request.                                      */
  349.         /* If sz is big enough, we should probably deallocate       */
  350.         /* part of the heap block here, but ...                     */
  351.         return(p);
  352.     } else {
  353.         /* shrink */
  354.           XR_Pointer result = GC_malloc_atomic(lb);
  355.  
  356.           bcopy(p, result, lb);
  357.           GC_free(p);
  358.           return(result);
  359.     }
  360.       } else {
  361.     /* grow */
  362.       XR_Pointer result = GC_malloc_atomic(lb);
  363.  
  364.       bcopy(p, result, sz);
  365.       GC_free(p);
  366.       return(result);
  367.       }
  368.     } else /* composite */ {
  369.       if (lb <= sz) {
  370.     if (lb >= (sz >> 1)) {
  371.         if (orig_sz > lb) {
  372.           /* Clear unneeded part of object to avoid bogus pointer */
  373.           /* tracing.                          */
  374.             bzero(((char *)p) + lb, orig_sz - lb);
  375.         }
  376.         return(p);
  377.     } else {
  378.         /* shrink */
  379.           XR_Pointer result = GC_malloc(lb);
  380.  
  381.           bcopy(p, result, lb);
  382.           GC_free(p);
  383.           return(result);
  384.     }
  385.       } else {
  386.     /* grow */
  387.       XR_Pointer result = GC_malloc(lb);
  388.  
  389.       bcopy(p, result, sz);
  390.       GC_free(p);
  391.       return(result);
  392.       }
  393.     }
  394. }
  395.  
  396. void GC_printf(fmt, a, b, c, d, e)
  397. char * fmt;
  398. long a,b,c,d,e;
  399. {
  400.     XR_StatsVMsg  fmt, a, b, c, d, e);
  401. }
  402.  
  403. void GC_vprintf(fmt, a, b, c, d, e)
  404. char * fmt;
  405. long a,b,c,d,e;
  406. {
  407.     XR_VerboseVMsg  fmt, a, b, c, d, e);
  408. }
  409.  
  410. void GC_iprintf(fmt, a, b, c, d, e)
  411. char * fmt;
  412. long a,b,c,d,e;
  413. {
  414.     XR_ErrorVMsg  fmt, a, b, c, d, e);
  415. }
  416.  
  417.  
  418. void GC_abort(s)
  419. char *s;
  420. {
  421.     if (GC_ok_to_panic) {
  422.       XR_PanicVMsg "%s\n",s);
  423.       XR_Panic(s);
  424.     } else {
  425.       XR_ErrorVMsg "%s\n  foolishly attempting to continue ...\n", s);
  426.     }  
  427. }
  428.  
  429. long XR_get_object_size(p)
  430.     struct obj *p;
  431. {
  432.     struct hblk * h = HBLKPTR(p);
  433.  
  434. #   ifdef INTERIOR_POINTERS
  435.       if (!is_hblk(h)) {
  436.     char m = get_map(h);
  437.     while (m > 0 && m < 0x7f) {
  438.         h -= m;
  439.         m = get_map(h);
  440.     }
  441.       }
  442. #   endif
  443.  
  444.     return WORDS_TO_BYTES(HB_SIZE(h));
  445. }
  446.  
  447.  
  448.  
  449. /*
  450.  * Kludge for pecularities of valloc counted on by the sun window system.
  451.  * Note that valloc'd pages are assumed to have no pointers!
  452.  * Return NIL if the allocation request threatens to cause the heap
  453.  * to grow beyond MAP_SIZE * HBLKSIZE.  This test is only a heuristic,
  454.  * since there may be holes between heap segments, and the limit is
  455.  * really on addresses rather than aggregate heap size.
  456.  * 
  457.  */
  458. #define VALLOC_LIMIT (MAP_SIZE * HBLKSIZE) - (6*1024*1024)
  459.  
  460. XR_Pointer XR_valloc(size)
  461. {
  462.   unsigned pagesize;
  463.   XR_Pointer base, oldbase;
  464.   pagesize = getpagesize();
  465.   
  466.   if ((GC_heapsize + size) > VALLOC_LIMIT) ERROR_RETURN;
  467.   if (pagesize > HBLKSIZE || HDR_BYTES != 0) {
  468.     oldbase = XR_pointerfree_new(size + pagesize);
  469.     /* round up to nearest pagesize boundary */
  470.     base = (XR_Pointer)(((int)(oldbase + (pagesize - 1))) & (~ (pagesize - 1)));
  471.   } else {
  472.     oldbase = base = GC_malloc_atomic(size >= pagesize? size : pagesize);
  473.   }  
  474.     
  475.   XR_make_uncollectable(oldbase, base);
  476.     
  477.   return base;
  478. }
  479.  
  480. /*
  481.  * Prevents an indicated object from ever being collected by putting
  482.  * it on a linked list connected rooted in a static.
  483.  */
  484.  
  485. void XR_make_uncollectable(pinaddr, knownAsAddr)
  486.      char *pinaddr, *knownAsAddr;
  487. {
  488.   struct uncollectable_structure *ptr;
  489. # ifdef PRINT_ALLOCS
  490.     GC_vprintf("Making %x (aka %x) uncollectable.\n", pinaddr, knownAsAddr);
  491. # endif
  492.   ptr = (struct uncollectable_structure *)
  493.         XR_malloc(sizeof(struct uncollectable_structure));
  494.   ptr->next = GC_pin_head;
  495.   ptr->addr1 = pinaddr;
  496.   ptr->addr2 = knownAsAddr;
  497.   GC_pin_head = ptr;
  498. }
  499.  
  500. void
  501. XR_unmake_uncollectable(ptr)
  502. char *ptr;
  503. {
  504.   register struct uncollectable_structure *p, *prev;
  505.   
  506.   if (ptr == 0) return;
  507.   p = GC_pin_head;
  508.   prev = 0;
  509.   while (p && p->addr1 != ptr && p->addr2 != ptr) {
  510.     prev = p;
  511.     p = p->next;
  512.   }
  513.   if (p) {
  514.     if (prev) {
  515.       prev->next = p->next;
  516.     } else {
  517.       GC_pin_head = p->next;
  518.     }
  519. #   ifdef PRINT_ALLOCS
  520.       GC_vprintf("Making %x (aka %x) collectable again.\n", p->addr1, p->addr2);
  521. #   endif
  522.     p->addr1 = 0;
  523.     p->addr2 = 0;
  524.   }
  525. }
  526.  
  527. void XR_valloc_free(ptr)
  528. char *ptr;
  529. {
  530.   XR_unmake_uncollectable(ptr);
  531. }
  532.  
  533.  
  534. /* The following are considered OBSOLETE, but are provided for backward */
  535. /* compatibility.  They may disappear in the future.                        */
  536.  
  537. void XR_unsafe_free(p)
  538. XR_Pointer p;
  539. {
  540.     XR_free(p);
  541. }
  542.  
  543. /* Similar to GC_malloc, but provide space for header. */
  544. XR_Pointer XR_malloc(lb)
  545. long lb;
  546. {
  547.     XR_Pointer result = (XR_Pointer)(((long)(GC_malloc(lb+8))) + 8);
  548.     
  549.     if (result == (XR_Pointer)8) {
  550.         ERROR_RETURN;
  551.     }
  552.     return(result);
  553. }
  554.  
  555. XR_Pointer XR_pointerfree_new(lb)
  556. long lb;
  557. {
  558.     XR_Pointer result = (XR_Pointer)(((long)(GC_malloc_atomic(lb+8))) + 8);
  559.     
  560.     if (result == (XR_Pointer)8) {
  561.         ERROR_RETURN;
  562.     }
  563.     return(result);
  564. }
  565.  
  566. XR_Pointer XR_new(lb)
  567. long lb;
  568. {
  569.     return(XR_malloc(lb));
  570. }
  571.  
  572. XR_Pointer XR_clear_new(i,j)
  573. long i,j;
  574. {
  575.     return(XR_malloc(i*j));
  576. }
  577.  
  578. XR_Pointer XR_ralloc(lw)
  579. unsigned lw;
  580. {
  581.     return(XR_pointerfree_new(WORDS_TO_BYTES(lw)));
  582. }
  583.  
  584. XR_Pointer XR_ralloc_comp(lw)
  585. unsigned lw;
  586. {
  587.     return(XR_malloc(WORDS_TO_BYTES(lw)));
  588. }
  589.  
  590. /* Similar to GC_free, but makes no assumption that p points to the beginning */
  591. /* of the object.                                  */
  592. void XR_free(p)
  593. {
  594.     register struct hblk * h;
  595.     register long word_no;
  596.     register unsigned long sz;
  597.  
  598.     h = HBLKPTR(p);
  599. #   ifdef INTERIOR_POINTERS
  600.       if (!is_hblk(h)) {
  601.     char m = get_map(h);
  602.     while (m > 0 && m < 0x7f) {
  603.         h -= m;
  604.         m = get_map(h);
  605.     }
  606.       }
  607.       sz = HB_SIZE(h);
  608. #   endif
  609.  
  610.     word_no = WORD_NO(p, h);
  611.     
  612. #   ifdef INTERIOR_POINTERS
  613.        word_no = adjusted_word_no(word_no,sz);
  614. #   endif
  615.  
  616.     GC_free(((word *)h) + word_no);
  617. }
  618.  
  619. XR_Pointer XR_calloc(i,j)
  620. long i,j;
  621. {
  622.     return(XR_malloc(i*j));
  623. }
  624.  
  625. XR_Pointer
  626. XR_realloc(old, size)
  627. register word *old;
  628. long size;
  629. {
  630.     register struct hblk * h;
  631.     register long word_no;
  632.     register unsigned long sz;
  633.     register word * old_beg;
  634.     register long offset;
  635.  
  636.     h = HBLKPTR(old);
  637. #   ifdef INTERIOR_POINTERS
  638.       if (!is_hblk(h)) {
  639.     char m = get_map(h);
  640.     while (m > 0 && m < 0x7f) {
  641.         h -= m;
  642.         m = get_map(h);
  643.     }
  644.       }
  645.       sz = HB_SIZE(h);
  646. #   endif
  647.  
  648.     word_no = WORD_NO(old, h);
  649.     
  650. #   ifdef INTERIOR_POINTERS
  651.        word_no = adjusted_word_no(word_no,sz);
  652. #   endif
  653.     old_beg = ((word *)h) + word_no;
  654.     offset = old - old_beg;
  655.     return((XR_Pointer)
  656.            (((word *)(GC_realloc(old_beg, size + WORDS_TO_BYTES(offset))))
  657.             + offset));
  658. }
  659.  
  660. /*
  661. XR_Pointer
  662. XR_realloc(old, size)
  663. register word *old;
  664. long size;
  665. {
  666.  
  667.   word *last;
  668.   register word *new;
  669.   register i;
  670.   long copySize;
  671.  
  672.   last = new = (word *)XR_malloc(size);
  673.   if (new == (word *)0) { return((XR_Pointer)0); }
  674.   copySize = XR_get_object_size( (struct obj *)(old) );
  675.   if( copySize > size ) copySize = size;
  676.   while( copySize > 0 ) {
  677.     *new++ = *old++;
  678.     copySize -= sizeof(word);
  679.   }
  680.  
  681.   return (XR_Pointer)last;
  682. }
  683. */
  684.  
  685. XR_Pointer
  686. XR_pointerfree_clear_new(size)
  687. int size;
  688. {
  689.   struct obj *p;
  690.   int lw;
  691.  
  692.   size =  lw =(size + (sizeof (word)) -1) / (sizeof (word));
  693.   p = (struct obj *) XR_ralloc(size);
  694.  
  695.   if (p == (struct obj *)0) {
  696.       return((XR_Pointer)0);
  697.   }
  698.  
  699.   for (lw--; lw >= 0; lw--) {
  700.       p -> obj_component[lw] = 0;
  701.   }
  702.  
  703.   return((XR_Pointer)p);
  704. }
  705.  
  706.  
  707. /*
  708.  * Versions of above routines that traffic in uncollectable
  709.  * pointer-free objects. Also considered OBSOLETE.
  710.  */
  711.  
  712. XR_Pointer
  713. XR_UNCollect_malloc(size)
  714. long size;
  715. {
  716.   XR_Pointer base = XR_pointerfree_clear_new(size);
  717.   XR_make_uncollectable(base,0);
  718.   return base;
  719.  
  720. }
  721.  
  722.  
  723. XR_Pointer
  724. XR_UNCollect_calloc(size_elem, num_elem)
  725. long size_elem, num_elem;
  726. {
  727.  
  728.   XR_Pointer base = XR_pointerfree_clear_new(size_elem * num_elem);
  729.   XR_make_uncollectable(base,0);
  730.   return base;
  731. }
  732.  
  733.  
  734. XR_Pointer
  735. XR_UNCollect_realloc(old, size)
  736. register word *old;
  737. long size;
  738. {
  739.   register word *new;
  740.   word *new2, *old2;
  741.   register i;
  742.   long copySize;
  743.  
  744.   new = new2 = (word *)XR_pointerfree_clear_new(size);
  745.   if (new == (word *)0) { return((XR_Pointer)0); }
  746.   XR_make_uncollectable(new,0); 
  747.   copySize = XR_get_object_size( (struct obj *)(old) );
  748.   if( copySize > size ) copySize = size;
  749.   while( copySize > 0 ) {
  750.     *new++ = *old++;
  751.     copySize -= sizeof(word);
  752.   }
  753.   XR_unmake_uncollectable(old2);
  754.  
  755.   return (XR_Pointer)new2;
  756. }
  757.  
  758.  
  759. void
  760. XR_UNCollect_free(ptr)
  761. char *ptr;
  762. {
  763.   XR_unmake_uncollectable(ptr);
  764. }
  765.  
  766.  
  767. /* The following are OBSOLETE control routines that may still be called
  768.  * by some clients.
  769.  */
  770. bool XR_GCGetMiserlyHeap()
  771. { return(FALSE); }
  772.  
  773. bool XR_GCSetMiserlyHeap(/* bool */)
  774. { return(FALSE); }